home *** CD-ROM | disk | FTP | other *** search
AMOS Source Code | 1990-08-11 | 11.8 KB | 492 lines |
- Default
- Dim CBCOL(73),CBDES(73),CBIMAGE(73),PLAN(12,8),NAM$(5),HSCORE(5)
- Global VER,QQ$,CROSS,MULT,GONE,NT$,CD,CC,MAINSCORE,TSCOR,CBCOL(),CBDES(),CBIMAGE(),PLAN(),XT,YT,XTEMP,YTEMP,NAM$(),HSCORE()
- TITESCN
- LODEHISCORES
- INSTUCTIONS
- If Upper$(QQ$)<>"H" Then Goto MSS
- SHOHIGHSCORES
- Wait Key
- Screen Close 2
- MSS:
- Screen Open 2,320,256,4,Lowres : Curs Off
- Pen 2 : Paper 0 : Cls 0
- Locate 6,10 : Print "Choose Tiles or Bricks (T/B)"
- Locate 6,12 : Print " Tiles are Easier !"
- SS: Q$=Upper$(Inkey$) : If Q$="" Then Goto SS
- If Q$="T"
- VER=0
- Else
- VER=48
- End If
- Screen Close 2
- Auto View Off
- If VER=0
- Unpack 7 To 1
- Else
- Unpack 8 To 1
- End If
- 'Load "df0:ishidosprites3.abk"
- Get Sprite Palette
- Cls 0,284,17 To 304,37
- BLANKTILES
- For N=0 To 15 : Colour N,0 : Next
- Auto View On
- Fade 7 : Wait 115
- Screen To Front 1 : Screen 1
- 'MAKENEWFILE
- 'SAVHISCORES
- 'End
- '--------------------restart game-------------------------
- BEG:
- Show On
- MAINSCORE=0 : TSCOR=0
- Cls 10,275,68 To 312,126
- KNOCKOFF[72,2]
- MULT=1 : GONE=0 : CROSS=0
- SETARRAYS
- Fade 7 To -1 : Wait 105
- Limit Mouse X Hard(10),Y Hard(10) To X Hard(260),Y Hard(176)
- Ink 7,0
- MAKEZEROES[MAINSCORE,6]
- MAKEZEROES[TSCOR,3]
- INITBOARD
- GONE=6 : KNOCKOFF[GONE,0]
- '
- '---------------------main loop----------------------
- CUBESLEFT=72
- HERE:
- If CUBESLEFT>1 Then CURRENTCUBE=Rnd(CUBESLEFT-1)+1
- If CBIMAGE(CURRENTCUBE)=0 Then Goto HERE
- For N=40 To 43
- Paste Bob 284,17,N+VER
- Wait 3
- Next N
- Paste Bob 284,17,CBIMAGE(CURRENTCUBE)
- PICKPLACE
- Cls 0,284,17 To 304,37
- GONE=GONE+1 : KNOCKOFF[GONE,0]
- If GONE=72 Then Goto FIN
- Goto HERE
- '-------------------end main loop---------------------
- '
- FIN:
- For N=20 To 80 : Play N,1 : Next
- TRYHIGH[MAINSCORE]
- Clear Key : Wait Key
- Screen To Front 1 : Screen 1
- Show
- BLANKTILES
- Goto BEG
- '--------------------------------
- '
- Procedure BLANKTILES
- For X=10 To 260 Step 21
- For Y=10 To 176 Step 21
- Paste Bob X,Y,37+VER
- Next : Next
- For X=31 To 239 Step 21
- For Y=31 To 155 Step 21
- Paste Bob X,Y,38+VER
- Next : Next
- End Proc
- Procedure GITCUBES
- B=0
- For Y=31 To 136 Step 21
- For X=73 To 178 Step 21
- B=B+1
- Get Bob B,X,Y To X+20,Y+20
- Next
- Next
- Get Bob 37,10,10 To 30,30
- Get Bob 38,31,31 To 51,51
- End Proc
- Procedure MONMOUS
- Do
- X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
- Locate 10,26 : Print X,Y
- Exit If Inkey$=" "
- Loop
- End Proc
- Procedure PICKPLACE
- Shared CURRENTCUBE
- AG:
- Repeat
- X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
- XM=X-(X-10) mod 21 : YM=Y-(Y-10) mod 21
- XT=(XM+11)/21 : YT=(YM+11)/21
- Until Mouse Click
- If PLAN(XT,YT)=0
- CHECKSCORE
- If TSCOR=0
- Goto AG
- End If
- Cls 0,XM,YM To XM+20,YM+20
- For N=43 To 40 Step -1
- Paste Bob XM,YM,N+VER
- Wait 5
- Cls 0,XM,YM To XM+20,YM+20
- Next N
- Wait 5
- For N=41 To 43
- Paste Bob XM,YM,N+VER
- Wait 5
- Cls 0,XM,YM To XM+20,YM+20
- Next N
- Paste Bob XM,YM,CBIMAGE(CURRENTCUBE)
- PLAN(XT,YT)=CURRENTCUBE
- CBIMAGE(CURRENTCUBE)=0
- Else
- Goto AG
- End If
- End Proc
- Procedure CHECKSCORE
- Shared CURRENTCUBE
- EDGE=0
- If XT=1 or XT=12 or YT=1 or YT=8
- EDGE=1
- End If
- TSCOR=0
- CC=CBCOL(CURRENTCUBE) : CD=CBDES(CURRENTCUBE)
- CHECK[1,0]
- CHECK[-1,0]
- CHECK[0,1]
- CHECK[0,-1]
- If TSCOR>0 and EDGE=0
- If TSCOR=4
- TSCOR=TSCOR*MULT
- MULT=MULT*2
- CROSS=CROSS+1
- FOURERS[CROSS]
- End If
- Ink 7,0
- MAKEZEROES[TSCOR,3]
- ' Text 247,220,NT$
- 'Ink 0 : Bar 239,212 To 270,223
- If VER=48
- L=0
- Else
- L=10
- End If
- For N=1 To 3
- X=Val(Mid$(NT$,N,1))
- Paste Bob 210+8*N,210,101+X+L
- Next N
- For J=1 To TSCOR
- MAINSCORE=MAINSCORE+1
- MAKEZEROES[MAINSCORE,6]
- Ink 7,0
- For N=1 To 6
- X=Val(Mid$(NT$,N,1))
- Paste Bob 65+8*N,210,101+X+L
- Next N
- Bell 40
- Wait 1
- Next J
- End If
- End Proc
- Procedure CHECK[XDEV,YDEV]
- If(XT+XDEV)>12 Then Pop Proc
- If(XT+XDEV)<1 Then Pop Proc
- If(YT+YDEV)>8 Then Pop Proc
- If(XT+XDEV)<1 Then Pop Proc
- If PLAN(XT+XDEV,YT+YDEV)>0
- SIDE=PLAN(XT+XDEV,YT+YDEV)
- 'Locate 10,27 : Print CBCOL(SIDE),CBDES(SIDE),SIDE
- If CBCOL(SIDE)=CC or CBDES(SIDE)=CD
- TSCOR=TSCOR+1
- End If
- End If
- End Proc
- Procedure SETARRAYS
- For N=1 To 72 : CBCOL(N)=0 : CBDES(N)=0 : Next
- For N=1 To 36 : CBIMAGE(N)=VER+N : Next
- For N=37 To 72 : CBIMAGE(N)=N+VER-36 : Next
- For A=1 To 12 : For B=1 To 8 : PLAN(A,B)=0 : Next : Next
- For Y=0 To 5
- For X=1 To 6
- CBCOL(6*Y+X)=Y+1
- CBDES(6*Y+X)=X
- Next X
- Next Y
- For Y=0 To 5
- For X=1 To 6
- CBCOL(36+6*Y+X)=Y+1
- CBDES(36+6*Y+X)=X
- Next X
- Next Y
- End Proc
- Procedure TEMP
- Screen Open 0,640,200,16,Hires
- Cls
- For Y=1 To 6
- For X=1 To 12
- Locate 5,1 : Print "CBCOL & CBDES"
- Locate X*5,Y+2 : Print CBCOL(12*(Y-1)+X);CBDES(12*(Y-1)+X)
- Next
- Next
- For Y=1 To 8
- For X=1 To 12
- Locate X*3,Y+10 : Print PLAN(X,Y)
- Next
- Next
- Wait Key
- Screen 1
- End Proc
- Procedure REDUCEEM
- Shared CURRENTCUBE,CUBESLEFT
- For N=CURRENTCUBE To CUBESLEFT
- CBIMAGE(N)=CBIMAGE(N+1)
- 'Follow CBIMAGE(N),CBIMAGE(N+1)
- ' CBCOL(N)=CBCOL(N+1)
- ' CBDES(N)=CBDES(N+1)
- Next
- CUBESLEFT=CUBESLEFT-1
- 'TEMP
- End Proc
- Procedure INITBOARD
- Paste Bob 52,52,CBIMAGE(1)
- Paste Bob 199,52,CBIMAGE(8)
- Paste Bob 52,115,CBIMAGE(15)
- Paste Bob 199,115,CBIMAGE(22)
- Paste Bob 94,73,CBIMAGE(29)
- Paste Bob 157,94,CBIMAGE(36)
- PLAN(3,3)=1
- PLAN(10,3)=8
- PLAN(3,6)=15
- PLAN(10,6)=22
- PLAN(5,4)=29
- PLAN(8,5)=36
- CBIMAGE(1)=0
- CBIMAGE(8)=0
- CBIMAGE(15)=0
- CBIMAGE(22)=0
- CBIMAGE(29)=0
- CBIMAGE(36)=0
- End Proc
- Procedure MAKEZEROES[T,W]
- NT$=Str$(T)
- NT$=Right$(NT$,Len(NT$)-1)
- NT$=String$("0",W-Len(NT$))+NT$
- End Proc
- Procedure KNOCKOFF[STP,K]
- Ink K
- V=0
- For Y=146 To 176 Step 5
- For N=273 To 315 Step 4
- Bar N,Y To N+1,Y+2
- V=V+1
- Exit If V=STP
- Next
- Exit If V=STP
- Next
- End Proc
- Procedure FOURERS[CX]
- Ink 8 : V=0
- For Y=68 To 128 Step 10
- For N=275 To 305 Step 10
- V=V+1
- Draw N,Y+2 To N+6,Y+2
- Draw N,Y+4 To N+6,Y+4
- Draw N+2,Y To N+2,Y+6
- Draw N+4,Y To N+4,Y+6
- Exit If V=CX
- Next
- Exit If V=CX
- Next
- End Proc
- Procedure INITHIGH
- For N=1 To 5
- Read A$ : NAM$(N)=A$
- Read X : HSCORE(N)=X
- Next
- Data "fred",90,"mary",110,"george",103,"harry",240,"Maggie",370
- ' TRYHIGH[116]
- End Proc
- Procedure TRYHIGH[SCR]
- MYSCORE=SCR
- SOGHT
- If MYSCORE>HSCORE(5)
- A$=""
- Curs Off : Bell
- For N=4 To 1 Step -1
- NAM$(N+1)=NAM$(N)
- HSCORE(N+1)=HSCORE(N)
- Next N
- NAM$(1)=A$ : HSCORE(1)=MYSCORE
- SOGHT
- SHOHIGHSCORES
- JK=0
- For N=1 To 5
- If NAM$(N)=""
- JK=N
- End If
- Next N
- Pen 2
- Locate 26,6+JK*2 : Print Using "#####";MYSCORE
- Locate 10,6+JK*2 : Curs On
- Clear Key
- A$=""
- For N=1 To 8
- ZZ: Q$=Inkey$
- If Q$=""
- Goto ZZ
- End If
- Exit If Q$=Chr$(13)
- A$=A$+Q$
- Print Right$(Q$,1);
- Next
- NAM$(JK)=A$
- Curs Off
- SAVHISCORES
- Clear Key
- Screen Close 2
- End If
- End Proc
- Procedure SHOHIGHSCORES
- Screen Open 2,320,256,16,Lowres :
- Screen To Front 2
- Hide : Curs Off
- Cls 0
- Ink 2
- Set Pattern 9
- Bar 10,10 To 310,190
- Set Pattern 0
- Ink 0
- Bar 30,30 To 290,170
- Pen 4 : Paper 0
- Locate 15,5 : Under On : Print "HIGH SCORES" : Under Off
- Pen 6
- For N=1 To 5
- Locate 10,2*(N+3) : Print NAM$(N)
- Locate 26,2*(N+3) : Print Using "#####";HSCORE(N)
- Next
- End Proc
- Procedure SOGHT
- Repeat
- MARK=0
- For N=1 To 4
- If HSCORE(N)<HSCORE(N+1)
- T=HSCORE(N)
- T$=NAM$(N)
- HSCORE(N)=HSCORE(N+1)
- NAM$(N)=NAM$(N+1)
- HSCORE(N+1)=T
- NAM$(N+1)=T$
- MARK=1
- End If
- Next N
- Until MARK=0
- End Proc
- Procedure LODEHISCORES
- Open In 1,"ishhigh.AMOS"
- For N=1 To 5
- Input #1,NAM$(N)
- Input #1,HSCORE(N)
- Next N
- Close 1
- End Proc
- Procedure SAVHISCORES
- Open Out 1,"ishhigh.AMOS"
- For N=1 To 5
- Print #1,NAM$(N)
- Print #1,HSCORE(N)
- Next N
- Close 1
- End Proc
- Procedure MAKENEWFILE
- For N=1 To 5
- Read NAM$(N)
- Read HSCORE(N)
- Next N
- Data "GERMAINE",90,"AMELIA",300,"IVY",193,"DOLLY",222,"ABALENE",120
- SAVHISCORES
- End Proc
- Procedure INSTUCTIONS
- Screen Open 2,320,240,8,Lowres
- Flash Off : Curs Off : Hide
- Cls 0
- Ink 7
- Box 0,0 To 320,240
- Box 2,2 To 318,238
- Under On
- Pen 6 : Paper 0 : Locate 10,2 : Print "ATISHOO INSTRUCTIONS"
- Under Off
- Pen 7
- Locate 1,7 : Print "Place Tiles on the Board with adjacent"
- Locate 1,8 : Print "sides, matching colours or designs."
- Locate 1,9 : Print "The outer darker area of the Board"
- Locate 1,10 : Print "may be used but points are not scored"
- Locate 1,11 : Print "on these parts. Matching Tiles on more"
- Locate 1,12 : Print "than one side scores extra points."
- Locate 1,13 : Print " Matching on four sides scores four"
- Locate 1,14 : Print "points in the first instance, but the"
- Locate 1,15 : Print "next fourway scores eight points, the"
- Locate 1,16 : Print "the next sixteen and so on"
- Locate 8,20 : Print "[P] to Play Game"
- Locate 8,22 : Print "[H] To see High Scores"
- BB: QQ$=Inkey$ : If QQ$="" Then Goto BB
- Fade 5 : Wait 75
- Screen Close 2
- End Proc
- Procedure TITESCN
- Screen Open 2,320,240,8,Lowres
- Pen 2 : Paper 0 : Cls 0
- A=Colour(0)
- B=Colour(1)
- C=Colour(2)
- D=Colour(3)
- E=Colour(4)
- F=Colour(5)
- G=Colour(6)
- H=Colour(7)
- For N=0 To 7 : Colour N,0 : Next
- Hide
- Flash Off
- Set Pattern 0
- Ink 2
- Plot 25,230-92 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 40,166,46,152,50,182,73,104,62,80,56,119,40,121,37,102,25,92,999,999
- Ink 6 : Paint 31,230-99 : Ink 2
- Plot 47,230-145 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 54,128,42,128,47,145,999,999
- Ink 0 : Paint 46,230-138 : Ink 2
- Plot 86,230-111 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 87,153,72,146,75,154,70,156,103,175,100,168,115,165,91,157,93,111,86,111,999,999
- Ink 6 : Paint 88,230-114 : Ink 2
- Plot 116,230-121 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 123,170,130,176,126,131,123,135,116,121,999,999
- Ink 6 : Paint 122,230-135 : Ink 2
- Plot 142,230-129 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 148,139,142,139,160,144,160,155,142,159,141,178,155,197,178,184,170,184,173,178,150,177,148,163,166,162,175,144,142,129,999,999
- Ink 6 : Paint 150,230-135 : Ink 2
- Plot 187,230-155 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 183,199,188,196,190,216,196,182,205,188,207,203,211,195,218,207,211,148,208,154,202,137,204,181,197,178,194,154,191,161,187,155,999,999
- Ink 6 : Paint 190,230-165 : Ink 2
- Plot 243,230-153 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 224,166,228,202,238,215,256,207,257,174,243,153,999,999
- Ink 6 : Paint 243,230-158 : Ink 2
- Plot 241,230-167 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 234,176,241,201,248,175,241,167,999,999
- Ink 0 : Paint 241,230-172 : Ink 2
- Plot 275,230-164 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 263,181,269,209,280,223,296,199,290,173,275,164,999,999
- Ink 6 : Paint 278,230-170 : Ink 2
- Plot 272,230-184 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 279,206,289,195,281,178,272,184,999,999
- Ink 0 : Paint 282,230-190 : Ink 2
- Plot 113,230-97 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop
- Data 245,134,221,118,240,112,113,97,999,999
- Ink 6 : Paint 138,230-103 : Ink 2
- 'Ink 4,7 : Set Pattern 12 : Paint 20,1
- Ink 0,7
- Text 60,184,"Programmed in AMOS BASIC"
- Text 60,200," By Colin Naylar "
- Fade 5,A,B,C,D,E,F,G,H
- Timer=0
- Repeat
- Exit If Inkey$<>""
- Until Timer=300
- Fade 5 : Wait 75
- Screen Close 2
- End Proc